home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / exploer / genmodul.bas < prev    next >
Encoding:
BASIC Source File  |  1999-09-22  |  5.6 KB  |  189 lines
  1. Attribute VB_Name = "genModule"
  2. ' as you can see i'm still working on it it may some bugs
  3. ' but some of the functions and subs work great
  4. ' hope you enjoy and make it usefull
  5. 'for any comments you can e-mail me at uzib@kkl.org.il
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12.  
  13. Global Const LISTVIEW_BUTTON = 11
  14. Public Const HKEY_CLASSES_ROOT = &H80000000
  15.  
  16. Declare Function GetModuleHandle Lib _
  17. "kernel32" Alias "GetModuleHandleA" _
  18. (ByVal lpModuleName As String) As Long
  19.  
  20. Declare Function ExtractIcon Lib "shell32.dll" Alias _
  21. "ExtractIconA" (ByVal hInst As Long, ByVal _
  22. lpszExeFileName As String, ByVal nIconIndex As Long) As Long
  23. Declare Function DrawIcon Lib "user32" _
  24. (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
  25. Declare Function LoadIcon Lib "user32" Alias _
  26. "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
  27. Declare Function GetDriveType Lib "kernel32" _
  28. Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
  29. Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey _
  30. As Long) As Long
  31. Declare Function RegQueryValue Lib "advapi32.dll" Alias _
  32. "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As _
  33. String, ByVal lpValue As String, lpcbValue As Long) As Long
  34.  
  35.  
  36.  
  37. Public fMainForm As frmMain
  38.  
  39.  
  40. Sub Main()
  41.     Set fMainForm = New frmMain
  42.     fMainForm.Show
  43. End Sub
  44.  
  45.  
  46.  
  47. Public Function qryReg(fileend As String)
  48. Dim a, subkey, valname, position, bufstr As String
  49. Dim valsize, value, newvalsize, iconvalue As Long
  50.  
  51. subkey = fileend
  52. bufstr = Space(50)
  53. valsize = 45
  54. newvalsize = 145
  55. value = RegQueryValue(HKEY_CLASSES_ROOT, subkey, _
  56. bufstr, valsize)
  57. a = bufstr
  58. frmMain.txtValue.text = a
  59. frmMain.txtValue.text = bufstr
  60. position = Trim(frmMain.txtValue.text) + "\DefaultIcon"
  61. bufstr = Space(150)
  62. iconvalue = RegQueryValue(HKEY_CLASSES_ROOT, position, _
  63. bufstr, newvalsize)
  64. RegCloseKey (HKEY_CLASSES_ROOT)
  65. qryReg = bufstr
  66. End Function
  67.  
  68.  
  69. Public Function GetExplorer()
  70. Dim a, subkey, valname, position, bufstr As String
  71. Dim valsize, value, newvalsize, iconvalue As Long
  72. Screen.MousePointer = 11
  73. subkey = "InternetExplorer.Application\CLSID"
  74. bufstr = Space(50)
  75. valsize = 45
  76. newvalsize = 145
  77. value = RegQueryValue(HKEY_CLASSES_ROOT, subkey, _
  78. bufstr, valsize)
  79. a = bufstr
  80. frmMain.txtValue.text = a
  81. frmMain.txtValue.text = bufstr
  82. position = "CLSID\" + Trim(frmMain.txtValue.text) + "\LocalServer32"
  83. bufstr = Space(150)
  84. iconvalue = RegQueryValue(HKEY_CLASSES_ROOT, position, _
  85. bufstr, newvalsize)
  86. RegCloseKey (HKEY_CLASSES_ROOT)
  87. frmMain.txtValue.text = ""
  88. Screen.MousePointer = 1
  89. GetExplorer = bufstr
  90. ''temp = Shell(bufstr, vbMaximizedFocus)
  91. End Function
  92.  
  93. Public Function exereg(fileend As String)
  94. Dim a, subkey, valname, position, bufstr As String
  95. Dim valsize, value, newvalsize, iconvalue As Long
  96.  
  97. subkey = fileend
  98. bufstr = Space(50)
  99. valsize = 45
  100. newvalsize = 145
  101. value = RegQueryValue(HKEY_CLASSES_ROOT, subkey, _
  102. bufstr, valsize)
  103. a = bufstr
  104. frmMain.txtValue.text = a
  105. frmMain.txtValue.text = bufstr
  106. position = Trim(frmMain.txtValue.text) + "\shell\open\command"
  107. bufstr = Space(150)
  108. iconvalue = RegQueryValue(HKEY_CLASSES_ROOT, position, _
  109. bufstr, newvalsize)
  110. RegCloseKey (HKEY_CLASSES_ROOT)
  111. exereg = bufstr
  112. End Function
  113.  
  114. Public Sub open_file(file_to_open As String)
  115.     Dim temp
  116. Dim result As String
  117.    Select Case Right(file_to_open, 3)
  118.     Case "EXE"
  119.        temp = Shell(file_to_open, vbNormalFocus)
  120.     Case Else
  121.         result = exereg(Right(file_to_open, 4))
  122.         ''uzi = Trim(result)
  123.         ''uzi = Right(uzi, 4)
  124.         ''frmMain.txtValue.Text = uzi
  125.         ''a = frmMain.txtValue.Text
  126.         i = InStr(1, Trim(result), "%", vbTextCompare)
  127.         If i = 0 Then
  128.            i = InStr(1, Trim(result), "/", vbTextCompare)
  129.         End If
  130.         If i > 0 Then
  131.             uzi = Left(Trim(result), i - 1)
  132.             ''uzi = """" + uzi + """"
  133.             uzi = "" + uzi + ""
  134.             file_to_open = "" + file_to_open + ""
  135.             temp = Shell(uzi + file_to_open, vbMaximizedFocus)
  136.         Else
  137.             temp = Shell("C:\WINDOWS\rundll32.exe shell32.dll,OpenAs_RunDLL " + file_to_open, vbNormalFocus)
  138.         End If
  139.     End Select
  140. End Sub
  141.  
  142. Sub ShowFileInfo(filespec, filepic)
  143.     Dim fs, f, s, datec
  144.     On Error Resume Next
  145.     Set fs = CreateObject("Scripting.FileSystemObject")
  146.     Set f = fs.GetFile(filespec)
  147.     frmFileProp.Show
  148.     frmFileProp.chkArchive.value = 0
  149.     frmFileProp.chkReadOnly.value = 0
  150.     frmFileProp.chkHidden.value = 0
  151.     frmFileProp.chkSystem.value = 0
  152.     frmFileProp.lblFPath.Caption = f.path
  153.     frmFileProp.pctPropf.Picture = filepic
  154.     frmFileProp.lblSize1.Caption = f.Size
  155.     frmFileProp.lblName1.Caption = f.Name
  156.     frmFileProp.lblType1.Caption = f.Type
  157.     frmFileProp.lbldCreate1.Caption = f.datecreated
  158.     frmFileProp.lblLastacc1.Caption = f.datelastaccessed
  159.     frmFileProp.lblLastmod1.Caption = f.datelastmodified
  160.     If f.Attributes And 32 Then frmFileProp.chkArchive.value = 1
  161.     If f.Attributes And 1 Then frmFileProp.chkReadOnly.value = 1
  162.     If f.Attributes And 2 Then frmFileProp.chkHidden.value = 1
  163.     If f.Attributes And 4 Then frmFileProp.chkSystem.value = 1
  164. 'eh:
  165. 'Resume
  166. End Sub
  167.  
  168.  
  169.  
  170. Public Sub showSearch(key, text, image)
  171.     frmSearch.Show
  172.     frmSearch.cmbiSlookIn.ImageList = frmMain.ImageList3
  173.     frmSearch.cmbiSlookIn.ComboItems.Add , key, Mid(text, 21, Len(text)), image
  174. End Sub
  175.  
  176.  
  177.  
  178. Public Function renameFile(oldName, newName) As Integer
  179.     Dim fs, f, s
  180.     Set fs = CreateObject("Scripting.FileSystemObject")
  181.     Set f = fs.GetFile(oldName)
  182.     If f.Attributes And 2 Then
  183.         renameFile = 1
  184.     Else
  185.         f.Name = newName
  186.         renameFile = 0
  187.     End If
  188. End Function
  189.